home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
EnigmA Amiga Run 1997 February
/
EnigmA AMIGA RUN 15 (1997)(G.R. Edizioni)(IT)[!][issue 1997-02][PLANET CD V].iso
/
enigma
/
earcd
/
comm
/
comm1
/
statty31.lha
/
statty
/
statty.rexx
< prev
Wrap
OS/2 REXX Batch file
|
1996-12-23
|
27KB
|
910 lines
/*
** $VER: statty.rexx 3.1 (23.12.96) Rolf Rotvel
**
** Uses rexxtricks.library, locale.library and rexxlocaldates.library
*/
area.mmtaglen = 30 /* In MM log tagnames are cut off after x chars */
path.cfg = 'mail:statty.cfg' /* Default path to cfg file */
/*
** Initializing
*/
signal on syntax
signal on error
/* Load libraries */
call addlib('rexxsupport.library', 0, -30, 0)
call addlib('rexxtricks.library', 0, -30, 0)
call addlib('locale.library', 0, -30, 0)
call addlib('rexxlocaldates.library', 0, -30, 0)
/* Parse argument - if any */
if arg() > 0 then do
parse arg path.cfg
if path.cfg = '?' then do
options prompt 'CONFIGFILE: '
parse pull path.cfg
if path.cfg = '' then exit
end
end
/* Get localized error strings */
cat = opencatalog('statty.catalog', 'english',)
msg.err_cfg = getcatalogstr(cat, 1, "Couldn't read configfile:")
msg.err_tosser = getcatalogstr(cat, 2, "Statty doesn't support:")
call closecatalog(cat)
/* Read & parse cfg file */
if ~readfile(path.cfg, cfg) then call errorexit(msg.err_cfg||' "'||path.cfg||'"')
do c = 1 to cfg.0
interpret cfg.c
end
drop cfg.
/* Check tosser */
uptosser = upper(tosser)
select
when uptosser = 'FOOZLE' then nop
when uptosser = 'SPOT' then nop
when uptosser = 'MAILMANAGER' then nop
when uptosser = 'CRASHMAIL' then do
toyou? = 0 /* CrashMail doesn't log letters to sysop */
end
otherwise call errorexit(msg.err_tosser||' "'||tosser||'"')
end
/* Get rest of error strings */
cat = opencatalog('statty.catalog', 'english',)
msg.err_read = getcatalogstr(cat, 3, "Couldn't read")
msg.err_find = getcatalogstr(cat, 4, "Couldn't find")
msg.err_del = getcatalogstr(cat, 5, "Couldn't delete")
msg.err_create = getcatalogstr(cat, 6, "Couldn't create")
msg.err_write = getcatalogstr(cat, 7, "Couldn't write")
/* Message strings */
if keeplog? then msg.bak_log = getcatalogstr(cat, 20, 'Backing up log to')
msg.no_msgs = getcatalogstr(cat, 21, 'No new messages to process')
msg.read = getcatalogstr(cat, 22, 'Reading')
msg.fin = getcatalogstr(cat, 23, 'Finished')
msg.calcdb = getcatalogstr(cat, 26, 'Calculating database')
msg.write = getcatalogstr(cat, 27, 'Writing')
if tosser = 'MailManager' then msg.dup_area = getcatalogstr(cat, 25, 'added to')
else do
msg.dup_area = getcatalogstr(cat, 24, 'Found areaname "%s" twice in')
if tosser = 'Spot' then do
msg.xport_start = getcatalogstr(cat, 28, 'Export started')
msg.xport_end = getcatalogstr(cat, 29, 'Export ended')
end
end
/* Strings used in outputfile */
msg.out_1 = getcatalogstr(cat, 100, 'echomail database created by Statty')
msg.out_2 = getcatalogstr(cat, 101, 'Database was started:')
msg.out_3 = getcatalogstr(cat, 102, 'Messages in database:')
msg.out_4 = getcatalogstr(cat, 103, 'to you')
msg.out_5 = getcatalogstr(cat, 104, 'from you')
msg.out_6 = getcatalogstr(cat, 105, 'This update')
msg.out_7 = getcatalogstr(cat, 106, 'Last update')
msg.out_8 = getcatalogstr(cat, 107, 'new messages')
msg.out_9 = getcatalogstr(cat, 108, 'in %s areas')
msg.out_10 = getcatalogstr(cat, 109, 'Areas')
msg.out_11 = getcatalogstr(cat, 110, 'Total')
msg.out_12 = getcatalogstr(cat, 111, 'New')
call closecatalog(cat)
/* Check paths */
if ~exists(path.log) then call errorexit(msg.err_find||' '||path.log)
if ~exists(path.area) then call errorexit(msg.err_find||' '||path.area)
/*
** Main
*/
/* Datestamp */
start.thisdb = date('i')||'.'||time('s')
/* Multitasking... */
call pragma('p', -1)
/* Backup logfile */
if keeplog? then do
if path.keeplog ~= '' then oldpath = makepath(pathpart(path.log), path.keeplog)
else oldpath = path.log||'.statty'
say msg.bak_log||' '||oldpath
if exists(oldpath) then call copyfile(path.log, oldpath, 'a')
else call copyfile(path.log, oldpath, 'c')
end
/* Read excludefile */
if path.exc = '' then path.exc = makepath(pathpart(path.db), 'statty.exclude')
if ~readfile(path.exc, area.exc) then area.exc.0 = 0
/* Parse db and area files */
if exists(path.db) then do
say msg.read||' '||path.db
if ~readfile(path.db, line) then call errorexit(msg.err_read||' '||path.db)
parse var line.1 start.firstdb start.lastdb start.areastamp .
parse value statef(path.area) with . . . . days mins ticks .
chkstamp = days||mins||ticks
if start.areastamp ~= chkstamp then do
start.areastamp = chkstamp
interpret 'call '||tosser||'area()'
num = 1
do d = 2 to line.0
parse var line.d _msgs '"' _name '"' _toyou _fromyou .
db.name.num = _name
db.msgs.num = _msgs
db.toyou.num = _toyou
db.fromyou.num = _fromyou
say count(num)
num = num + 1
end
db.name.0 = num - 1
end
else do
num = 1
do d = 2 to line.0
parse var line.d _msgs '"' _name '"' _toyou _fromyou .
if area.exc.0 > 0 then do
if lsearch(_name, area.exc) ~= -1 then iterate
end
area.name.num = _name
db.name.num = _name
db.msgs.num = _msgs
db.toyou.num = _toyou
db.fromyou.num = _fromyou
say count(num)
num = num + 1
end
area.name.0 = num - 1
db.name.0 = area.name.0
end
end
else do
interpret 'call '||tosser||'area()'
start.firstdb = start.thisdb
start.lastdb = start.thisdb
parse value statef(path.area) with . . . . days mins ticks .
start.areastamp = days||mins||ticks
do a = 1 to area.name.0
db.name.a = area.name.a
db.msgs.a = 0
db.toyou.a = 0
db.fromyou.a = 0
end
end
/* Parse log file */
log.name.0 = 0
interpret 'call '||tosser||'log()'
if log.name.0 = 0 then say msg.no_msgs
else do
call calculatedb() /* Calculate database */
call putdb() /* Write database */
call genoutput() /* Write output */
end
if ~delete(path.log) then call errorexit(msg.err_del||' '||path.log)
say msg.fin
exit
ERROREXIT:
say arg(1)
exit 10
SPOTAREA: procedure expose area. msg. path.
say msg.read||' '||path.area
if ~readfile(path.area, line) then call errorexit(msg.err_read||' '||path.area)
num = 1
do a = 1 to line.0
chk = upper(line.a)
/* Skip separator, bad, default & netmail areas */
if pos(' SEPARATOR', chk) > 0 | pos(' BAD', chk) > 0 |,
pos(' DEFAULT', chk) > 0 | pos(' NETMAIL', chk) > 0 then iterate
parse var line.a . '"' . '"' '"' _user '"'
/* Is areaname in excludefile? */
if area.exc.0 > 0 then do
if lsearch(_user, area.exc) ~= -1 then iterate
end
/* A duplicate (user) areaname?!? */
if lsearch(_user, area.name) ~= -1 then call errorexit,
(replace(msg.dup_area, '%s', _user)||' '||path.area||'!')
area.name.num = _user
area.name.0 = num /* Needed for lsearch() */
say count(num)
num = num + 1
end
return
FOOZLEAREA: procedure expose area. msg. path.
say msg.read||' '||path.area
if ~open('tmp', path.area, 'r') then call errorexit(msg.err_read||' '||path.area)
num = 1
null = '0'x
do forever
_name = readch('tmp', 24) /* Read areaname */
if eof('tmp') then leave /* Break condition */
tag = upper(strip(readch('tmp', 24), 't', null)) /* Read tagname */
dir = compress(readch('tmp', 32), null) /* Read areadir */
call seek('tmp', 128 + 520) /* Skip rest of area definition */
/* Iterate if not valid area ? */
if dir = '' | ~exists(dir) | tag = 'BAD' |,
tag = 'MATRIX' then iterate
_name = strip(_name, 't', null)
/* Is areaname in excludefile? */
if area.exc.0 > 0 then do
if lsearch(_name, area.exc) ~= -1 then iterate
end
/* A duplicate areaname?!? */
if lsearch(_name, area.name) ~= -1 then call errorexit,
(replace(msg.dup_area, '%s', _name)||' '||path.area||'!')
area.name.num = _name
area.name.0 = num /* Needed for lsearch() */
say count(num)
num = num + 1
end
call close('tmp')
return
MAILMANAGERAREA: procedure expose area. msg. path.
say msg.read||' '||path.area
if ~readfile(path.area, line) then call errorexit(msg.err_read||' '||path.area)
num = 1
start = 1
do forever
/* Skip bad, netmail, fileecho & tick areas */
a = lsearch("'#ECHOAREA #?", line, start,, pattern)
if a = -1 then leave
start = a + 1
parse var line.a . '"' . '"' _name .
/* Is areaname in excludefile? */
if area.exc.0 > 0 then do
if lsearch(_name, area.exc) ~= -1 then iterate
end
if length(_name) > area.mmtaglen then do
subname = left(_name, area.mmtaglen)
chk = lsearch(subname||'#?', area.name,,, 'p')
if chk ~= -1 then do
say '"'||_name||'" '||msg.dup_area||' '||path.exc
if area.exc.0 > 0 then call open('tmp', path.exc, 'a')
else do
if ~open('tmp', path.exc, 'w') then call errorexit(msg.err_create||' '||path.exc)
area.exc.0 = 1
end
call writeln('tmp', _name)
call close('tmp')
end
end
area.name.num = _name
area.name.0 = num
say count(num)
num = num + 1
end
return
CRASHMAILAREA: procedure expose area. msg. path.
say msg.read||' '||path.area
if ~readfile(path.area, line) then call errorexit(msg.err_read||' '||path.area)
num = 1
start = 1
do forever
/* Skip bad, netmail, fileecho & tick areas */
a = lsearch("AREA #?", line, start,, pattern)
if a = -1 then leave
start = a + 1
parse var line.a . _name .
upname = upper(name)
if upname = 'BAD' | upname = 'DEFAULT' then iterate
/* Is areaname in excludefile? */
if area.exc.0 > 0 then do
if lsearch(_name, area.exc) ~= -1 then iterate
end
area.name.num = _name
area.name.0 = num
say count(num)
num = num + 1
end
return
SPOTLOG: procedure expose log. area. msg. path.
say msg.read||' '||path.log
if ~readfile(path.log, line) then call errorexit(msg.err_read||' '||path.log)
num = 1
export? = 0
counter = 1
do l = 1 to line.0
first = left(line.l, 1)
select
when pos(msg.xport_start, line.l) > 0 then export? = 1
when pos(msg.xport_end, line.l) > 0 then export? = 0
when first = '*' | first = '!' then do
parse var line.l . "'" _name "'" rest
/* Iterate if it's not a valid areaname */
if lsearch(_name, area.name) = -1 then iterate
/* Find amount of msgs imported */
wds = words(rest)
do w = 1 to wds
_msgs = word(rest, w)
if datatype(_msgs, 'w') then leave
end
/* Parse rest of line if any msgs for you */
if ~export? then do
if first = '*' then do ww = w + 1 to wds
_toyou = word(rest, ww)
if datatype(_toyou, 'w') then leave
end
else _toyou = 0
/* Is it first time we find this areaname in logfile? */
chk = lsearch(_name, log.name)
if chk = -1 then do /* Initialize variables */
log.name.num = _name
log.msgs.num = _msgs
log.toyou.num = _toyou
log.fromyou.num = 0
log.name.0 = num /* Need this for lsearch() */
num = num + 1
end
else do /* Update variables */
log.msgs.chk = log.msgs.chk + _msgs
log.toyou.chk = log.toyou.chk + _toyou
end
say count(counter)
counter = counter + 1
end
else do /* Export! */
chk = lsearch(_name, log.name)
if chk = -1 then do /* Initialize variables */
log.name.num = _name
log.msgs.num = _msgs
log.toyou.num = 0
log.fromyou.num = _msgs
log.name.0 = num /* Need this for lsearch() */
num = num + 1
end
else do /* Update variables */
log.msgs.chk = log.msgs.chk + _msgs
log.fromyou.chk = log.fromyou.chk + _msgs
end
say count(counter)
counter = counter + 1
end
end
otherwise nop
end
end
return
FOOZLELOG: procedure expose log. area. path. msg.
say msg.read||' '||path.log
if ~readfile(path.log, line) then call errorexit(msg.err_read||' '||path.log)
num = 1
do l = 1 to line.0
if word(line.l, 4) = 'Area' then do
parse var line.l . '"' _name '"' rest
/* Iterate if it's not a valid areaname */
if lsearch(_name, area.name) = -1 then iterate
/* Find amount of msgs imported */
wds = words(rest)
do w = 1 to wds
_msgs = word(rest, w)
if datatype(_msgs, 'w') then leave
end
/* Parse rest of line if any msgs for you */
if right(line.l, 7) = 'for you' then do ww = w + 1 to wds
_toyou = word(rest, ww)
if datatype(_toyou, 'w') then leave
end
else _toyou = 0
/* Is it first time we find this areaname in logfile? */
chk = lsearch(_name, log.name)
if chk = -1 then do /* Initialize variables */
log.name.num = _name
log.msgs.num = _msgs
log.toyou.num = _toyou
log.fromyou.num = 0 /* Foozle doesn't support this...*/
log.name.0 = num /* Need this for lsearch() */
num = num + 1
end
else do /* Update variables */
log.msgs.chk = log.msgs.chk + _msgs
log.toyou.chk = log.toyou.chk + _toyou
end
say count(counter)
counter = counter + 1
end
end
return
MAILMANAGERLOG: procedure expose log. area. msg. path.
say msg.read||' '||path.log
if ~readfile(path.log, line) then call errorexit(msg.err_read||' '||path.log)
num = 1
startimp = 'Import Statistics'
endimp = 'Import Used'
startexp = 'Start Export Function'
endexp = 'End Export Function'
action = ''
counter = 1
do l = 1 to line.0
if action = '' then do
select
when pos(startimp, line.l) > 0 then action = 'imp'
when pos(startexp, line.l) > 0 then action = 'exp'
otherwise nop
end
end
else do
select
when pos(endimp, line.l) > 0 then action = ''
when pos(endexp, line.l) > 0 then action = ''
when word(line.l, 7) = 'Area' then do
if action = 'imp' then do
parse var line.l . 'Area' _name _msgs '(' _toyou ')'
/* Iterate if it's not a valid areaname */
if length(_name) < area.mmtaglen then chk = lsearch(_name, area.name)
else chk = lsearch(_name||'#?', area.name,,, 'p')
if chk = -1 then iterate
_msgs = strip(_msgs)
_toyou = strip(_toyou)
/* Is it first time we find this areaname in logfile? */
chk = lsearch(_name, log.name)
if chk = -1 then do /* Initialize variables */
log.name.num = _name
log.msgs.num = _msgs
log.toyou.num = _toyou
log.fromyou.num = 0
log.name.0 = num /* Need this for lsearch() */
num = num + 1
end
else do /* Update variables */
log.msgs.chk = log.msgs.chk + _msgs
log.toyou.chk = log.toyou.chk + _toyou
end
say count(counter)
counter = counter + 1
end
else do /* Standalone export */
parse var line.l . 'Area' _name _fromyou .
if length(_name) < area.mmtaglen then chk = lsearch(_name, area.name)
else chk = lsearch(_name||'#?', area.name,,, 'p')
if chk = -1 then iterate
chk = lsearch(_name, log.name)
if chk = -1 then do /* Initialize variables */
log.name.num = _name
log.msgs.num = _fromyou
log.toyou.num = 0
log.fromyou.num = _fromyou
log.name.0 = num /* Need this for lsearch() */
num = num + 1
end
else do /* Update variables */
log.msgs.chk = log.msgs.chk + _fromyou
log.fromyou.chk = log.fromyou.chk + _fromyou
end
say count(counter)
counter = counter + 1
end
end
otherwise nop
end
end
end
return
CRASHMAILLOG: procedure expose log. area. path. msg.
say msg.read||' '||path.log
if ~readfile(path.log, line) then call errorexit(msg.err_read||' '||path.log)
num = 1
counter = 1
do l = 1 to line.0
if word(line.l, 4) = 'Area' then do
parse var line.l . . . . _name . _msgs .
/* Iterate if it's not a valid areaname */
if lsearch(_name, area.name) = -1 then iterate
/* Is it first time we find this areaname in logfile? */
chk = lsearch(_name, log.name)
if chk = -1 then do /* Initialize variables */
log.name.num = _name
log.msgs.num = _msgs
log.toyou.num = 0 /* CrashMail doesn't support this...*/
log.fromyou.num = 0 /* CrashMail doesn't support this...*/
log.name.0 = num /* Need this for lsearch() */
num = num + 1
end
else log.msgs.chk = log.msgs.chk + _msgs /* Update variable */
say count(counter)
counter = counter + 1
end
end
return
CALCULATEDB: procedure expose area. msg. log. db.
say msg.calcdb
area.length = 0
area.maxmsgs = 0
area.maxtoyou = 0
area.maxnewmsgs = 0
area.maxnewtoyou = 0
area.maxfromyou = 0
area.maxnewfromyou = 0
area.totalmsgs = 0
area.totaltoyou = 0
area.totalfromyou = 0
area.totallogmsgs = 0
area.totallogtoyou = 0
area.totallogfromyou = 0
do a = 1 to area.name.0
say count(a)
chklog = lsearch(area.name.a, log.name)
if chklog = -1 then do
newmsgs = 0
newtoyou = 0
newfromyou = 0
end
else do
newmsgs = log.msgs.chklog
newtoyou = log.toyou.chklog
newfromyou = log.fromyou.chklog
end
chkdb = lsearch(area.name.a, db.name)
if chkdb = -1 then do
dbmsgs = 0
dbtoyou = 0
dbfromyou = 0
end
else do
dbmsgs = db.msgs.chkdb
dbtoyou = db.toyou.chkdb
dbfromyou = db.fromyou.chkdb
end
_msgs = newmsgs + dbmsgs
_toyou = newtoyou + dbtoyou
_fromyou = newfromyou + dbfromyou
area.totallogmsgs = area.totallogmsgs + newmsgs
area.totallogtoyou = area.totallogtoyou + newtoyou
area.totallogfromyou = area.totallogfromyou + newfromyou
area.totalmsgs = area.totalmsgs + _msgs
area.totaltoyou = area.totaltoyou + _toyou
area.totalfromyou = area.totalfromyou + _fromyou
area.length = max(area.length, length(area.name.a))
db.string.a = _msgs||' "'||area.name.a||'" '||_toyou||' '||_fromyou
area.string.a = db.string.a||' '||newmsgs||' '||newtoyou||' '||newfromyou
/* These variables needed when calculating/formatting output */
area.maxmsgs = max(_msgs, area.maxmsgs)
area.maxtoyou = max(_toyou, area.maxtoyou)
area.maxfromyou = max(_fromyou, area.maxfromyou)
area.maxnewmsgs = max(newmsgs + newtoyou, area.maxnewmsgs)
area.maxnewtoyou = max(newtoyou, area.maxnewtoyou)
area.maxnewfromyou = max(newfromyou, area.maxnewfromyou)
end
db.string.0 = area.name.0
area.string.0 = area.name.0
drop log.
return
PUTDB: procedure expose db. start. msg. path.
say msg.write||' '||path.db
line = start.firstdb||' '||start.thisdb||' '||start.areastamp
call steminsert(db.string, 1,, line)
if ~writefile(path.db, db.string) then call errorexit(msg.err_write||' '||path.db)
drop db.
return
GENOUTPUT: procedure expose start. area. msg. path. tosser toyou? allareas?
say msg.write||' '||path.out
/* Convert datestamps to normal dates */
template = '%e %B %Y %R'
loc = openlocale()
parse var start.thisdb ds.days '.' ds.seconds
start.thisdb = strip(formatdate(loc, ds, template))
if start.firstdb ~= start.thisdb then do
parse var start.firstdb ds.days '.' ds.seconds
start.firstdb = strip(formatdate(loc, ds, template))
parse var start.lastdb ds.days '.' ds.seconds
start.lastdb = strip(formatdate(loc, ds, template))
end
else do
start.firstdb = start.thisdb
start.lastdb = start.thisdb
end
call closelocale(loc)
/* Sort areas */
call qsort(area.string,, 'num', 1)
if area.totalfromyou > 0 then fromyou? = 1
else fromyou? = 0
msg_len = length(area.maxmsgs)
newmsg_len = length(area.maxnewmsgs)
if toyou? then do
toyou_len = length(area.maxtoyou)
newtoyou_len = length(area.maxnewtoyou)
pad_len = msg_len + 1 + 1 + toyou_len + 1 /* A space + '()' */
if fromyou? then do
fromyou_len = length(area.maxfromyou)
newfromyou_len = length(area.maxnewfromyou)
pad_len = pad_len + 1 + fromyou_len /* A space */
end
end
else pad_len = msg_len
totallen = length(msg.out_11) + 1
width = 3
do while width + pad_len < totallen
width = width + 1
end
spaces = makespaces(width)
spaces_minus_one = makespaces(width - 1) /* '100%' kludge */
line.1 = tosser||' '||msg.out_1||' '||word(sourceline(2), 4)
line.2 = ''
line.3 = msg.out_2||' '||start.firstdb
line.4 = msg.out_3||' '||area.totalmsgs
if toyou? then do
if fromyou? then line.4 = line.4||' ('||area.totaltoyou||' '||msg.out_4||', '||area.totalfromyou||' '||msg.out_5||')'
else line.4 = line.4||' ('||area.totaltoyou||' '||msg.out_4||')'
end
line.5 = ''
line.6 = msg.out_6||' '||start.thisdb
line.7 = msg.out_7||' '||start.lastdb
line.8 = area.totallogmsgs||' '||msg.out_8
if toyou? then do
if fromyou? then line.8 = line.8||' ('||area.totallogtoyou||' '||msg.out_4||', '||area.totallogfromyou||' '||msg.out_5||')'
else line.8 = line.8||' ('||area.totallogtoyou||' '||msg.out_4||')'
end
line.8 = line.8||' '||replace(msg.out_9, '%s', area.string.0)
line.9 = ''
line.10 = left(msg.out_10, area.length)||spaces||left('%', 5)||spaces||,
left(msg.out_11, pad_len + width)||msg.out_12
line.11 = ''
num = 12 /* Number of lines in header + 1 */
do q = area.string.0 to 1 by -1
parse var area.string.q _msgs '"' areaname '"' _toyou _fromyou newmsgs newtoyou newfromyou .
if ~allareas? & _msgs = 0 then leave
_msgs = strip(_msgs)
if toyou? then do
if fromyou? then do
youtotal = ' ('||right(_toyou, toyou_len)||' '||right(_fromyou, fromyou_len)||')'
younew = ' ('||right(newtoyou, newtoyou_len)||' '||right(newfromyou, newfromyou_len)||')'
end
else do
youtotal = ' ('||right(_toyou, toyou_len)||')'
younew = ' ('||right(newtoyou, newtoyou_len)||')'
end
end
else do
youtotal = ''
younew = ''
end
line.num = left(strip(areaname), area.length)||spaces_minus_one||,
format(((_msgs / area.totalmsgs) * 100), 3, 2)||spaces||,
right(_msgs, msg_len)||youtotal||spaces||,
right(newmsgs, newmsg_len)||younew
say count(num)
num = num + 1
end
line.0 = num - 1
if ~writefile(path.out, line) then call errorexit(msg.err_write||' '||path.out)
return
/*
** Generic procedures
*/
MAKESPACES: procedure
return copies(' ', arg(1))
COUNT: procedure
return ' '||arg(1)||'9b'x||'A'
FORMAT: procedure
arg number, before, after
/* Reformats the number to NUMERIC DIGITS setting */
num = number + 0
/* Return the reformatted number if other options not specified */
if before = '' & after = '' then return num
/* Split the number into fraction and integer */
parse var num integer '.' fraction
/* Set defaults for non-spec'd arguments */
if before = '' then before = length(integer)
if after = '' then after = length(fraction)
/* [before] argument must be at least as long as integer */
if before < length(integer) then return '**ERROR**'
/* add an appropriate value of .5 to number to round it */
if after ~= length(fraction) then do
fraction = trunc(('.'||fraction||'0') + ('.'||copies('0', after)||'5'), after)
/* Numbers created as text strings are still numbers */
integer = integer + (fraction % 1)
fraction = substr(fraction, 3)
end
if fraction >= 0 then return right(integer, before)||'.'||fraction
else return right(integer, before)
/*
** copyfile(sourcefile, destfile)
*/
COPYFILE: procedure
parse arg from, to , mode
sz = word(statef(from), 2)
call open('s', from, 'r')
if upper(mode) = 'A' then call open('d', to, 'a')
else call open('d', to, 'w')
do (sz % 65535) + 1
call writech('d', readch('s', 65535))
end
call close('d')
call close('s')
return
/*
** Replace(string, old, new)
*/
REPLACE: procedure
parse arg src, old, new
str = ''
do while src ~= ''
chk = pos(old, src)
parse var src pre (old) src
str = str||pre
if chk > 0 then str = str||new
end
return str
/*
** Use while developing...
*/
SYNTAX:
ERROR:
trace o
err = rc ; line = sigl
if datatype(err, 'n') then do
errline = 'Error '||err||': '||errortext(err)||'0a'x||'in line '||line
sayit? = 1
if show('p', 'rexx_ced') then do
parse source . . filename .
options results
address 'rexx_ced'
'cedtofront'
'ow' filename
'jump to line' line
'okay1' errline
sayit? = 0
end
else say errline
end
exit